home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue55 / Contain / MoreLists.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-19  |  3.1 KB  |  150 lines
  1. unit MoreLists;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, SysUtils;
  7.  
  8. type
  9.  
  10.   TListNotifyEvent = procedure(Sender: TObject; Ptr: Pointer;
  11.       Action: TListNotification) of Object;
  12.  
  13.   TNotifyList = class(TList)
  14.   private
  15.     FOnChange: TListNotifyEvent;
  16.   protected
  17.     procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  18.   public
  19.     property OnChange: TListNotifyEvent read FOnChange write FOnChange;
  20.   end;
  21.  
  22.   EBigQueueException = class(Exception);
  23.  
  24.   TBigQueue = class
  25.   private
  26.     LL: TList;
  27.     NextPopIndex: Integer;
  28.     NextPushIndex: Integer;
  29.     PopList: TList;
  30.     PushList: TList;
  31.   protected
  32.     procedure CreateNewItemList;
  33.   public
  34.     constructor Create;
  35.     destructor Destroy; override;
  36.     function Count: Integer;
  37.     function AtLeast(ACount: Integer): Boolean;
  38.     function HasItems: Boolean;
  39.     procedure Push(AItem: Pointer);
  40.     function Pop: Pointer;
  41.     function Peek: Pointer;
  42.   end;
  43.  
  44. implementation
  45.  
  46. { TBigQueue }
  47.  
  48. const
  49.   QUEUE_LIST_CAPACITY = 1024;
  50.  
  51. function TBigQueue.AtLeast(ACount: Integer): Boolean;
  52. begin
  53.   Result := ACount >= Count;
  54. end;
  55.  
  56. function TBigQueue.Count: Integer;
  57. begin
  58.   if PopList = PushList then
  59.     Result := NextPushIndex - NextPopIndex
  60.   else
  61.     Result := QUEUE_LIST_CAPACITY - NextPopIndex + NextPushIndex;
  62.   if LL.Count > 2 then
  63.     Inc(Result, ((LL.Count - 2) * QUEUE_LIST_CAPACITY));
  64. end;
  65.  
  66. constructor TBigQueue.Create;
  67. begin
  68.   inherited Create;
  69.   LL := TList.Create;
  70.   CreateNewItemList;
  71.   PopList := PushList;
  72.   NextPushIndex := 0;
  73.   NextPopIndex := 0;
  74. end;
  75.  
  76. procedure TBigQueue.CreateNewItemList;
  77. begin
  78.   PushList := TList.Create;
  79.   PushList.Count := QUEUE_LIST_CAPACITY;
  80.   NextPushIndex := 0;
  81.   LL.Add(PushList);
  82. end;
  83.  
  84. destructor TBigQueue.Destroy;
  85. var
  86.   I: Integer;
  87. begin
  88.   for I := 0 to (LL.Count - 1) do
  89.     TList(LL[I]).Free;
  90.   inherited Destroy;
  91. end;
  92.  
  93. function TBigQueue.HasItems: Boolean;
  94. begin
  95.   Result := (PopList <> PushList) or
  96.     ((NextPopIndex + 1) < NextPushIndex);
  97. end;
  98.  
  99. function TBigQueue.Peek: Pointer;
  100. begin
  101.   if (PopList <> PushList) or
  102.       (NextPopIndex < NextPushIndex) then
  103.     Result := PopList[NextPopIndex]
  104.   else
  105.     raise EBigQueueException.Create('Pop or Peek invoked ' +
  106.         'when no item available');
  107. end;
  108.  
  109. function TBigQueue.Pop: Pointer;
  110. begin
  111.   Result := Peek;
  112.   Inc(NextPopIndex);
  113.   if (PopList = PushList) then
  114.   begin
  115.     if (NextPopIndex = NextPushIndex) then
  116.     begin
  117.       NextPopIndex := 0;
  118.       NextPushIndex := 0;
  119.     end;
  120.   end
  121.   else
  122.   begin
  123.     if (NextPopIndex = QUEUE_LIST_CAPACITY) then
  124.     begin
  125.       LL.Delete(0);
  126.       PopList := TList(LL[0]);
  127.       NextPopIndex := 0;
  128.     end;
  129.   end;
  130. end;
  131.  
  132. procedure TBigQueue.Push(AItem: Pointer);
  133. begin
  134.   if NextPushIndex = QUEUE_LIST_CAPACITY then
  135.     CreateNewItemList;
  136.   PushList[NextPushIndex] := AItem;
  137.   Inc(NextPushIndex);
  138. end;
  139.  
  140. { TNotifyList }
  141.  
  142. procedure TNotifyList.Notify(Ptr: Pointer; Action: TListNotification);
  143. begin
  144.   inherited Notify(Ptr, Action);
  145.   if Assigned(FOnChange) then
  146.     FOnChange(Self, Ptr, Action);
  147. end;
  148.  
  149. end.
  150.